home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / streams.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  18KB  |  737 lines
  1. /* ******************************************************************** */
  2. /*  streams.c        Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Stream handling                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, May 1989
  10.  */
  11.  
  12.  
  13. #include <string.h>
  14. #include <stdio.h>
  15. #include "defs.h"
  16. #include "structs.h"
  17. #include "funcalls.h"
  18.  
  19. #include "error.h"
  20. #include "global.h"
  21.  
  22. #include "modboot.h"
  23. #include "symboot.h"
  24. #include "ngenerics.h"
  25.  
  26. static LispObject sym_input;
  27. static LispObject sym_output;
  28. static LispObject sym_io;
  29.  
  30. static LispObject sym_character;
  31. static LispObject sym_binary;
  32.  
  33. LispObject sym_append;
  34. static LispObject sym_create;
  35. static LispObject sym_overwrite;
  36. static LispObject sym_new_version;
  37. static LispObject sym_start;
  38. static LispObject sym_end;
  39.  
  40. LispObject StdIn;
  41. LispObject StdOut;
  42. LispObject StdErr;
  43. LispObject TraceOut;
  44. LispObject DebugIO;
  45.  
  46. EUFUN_1( Fn_streamp, form)
  47. {
  48.   return (is_stream(form) ? lisptrue : nil);
  49. }
  50. EUFUN_CLOSE
  51.  
  52. EUFUN_2( Fn_open, path, ops)
  53. {
  54.   LispObject direction = NULL,mode = NULL;
  55.   int create = -1,append = -1;
  56.   
  57.   LispObject walker,str;
  58.   FILE *fd;
  59.   char *way;
  60.   int retry_count = 0;
  61.  
  62.   if (!is_string(path))
  63.     CallError(stacktop,"open: not a string",path,NONCONTINUABLE);
  64.  
  65.   walker = ops;
  66.  
  67.   while (is_cons(walker)) {
  68.     LispObject op;
  69.  
  70.     op = CAR(walker); walker = CDR(walker);
  71.  
  72.     if (!is_symbol(op))
  73.       CallError(stacktop,"open: invalid option",op,NONCONTINUABLE);
  74.  
  75.     if (op == sym_input) {
  76.       if (direction != NULL)
  77.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  78.       else
  79.     direction = op;
  80.       continue;
  81.     }
  82.  
  83.     if (op == sym_output) {
  84.       if (direction != NULL)
  85.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  86.       else
  87.     direction = op;
  88.       continue;
  89.     }
  90.  
  91.     if (op == sym_io) {
  92.       if (direction != NULL)
  93.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  94.       else
  95.     direction = op;
  96.       continue;
  97.     }
  98.  
  99.     if (op == sym_character) {
  100.       if (mode != NULL)
  101.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  102.       else
  103.     mode = op;
  104.       continue;
  105.     }
  106.  
  107.     if (op == sym_binary) {
  108.       if (mode != NULL)
  109.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  110.       else
  111.     CallError(stacktop,"open: binary mode unsupported",ops,NONCONTINUABLE);
  112.       continue;
  113.     }
  114.  
  115.     if (op == sym_create) {
  116.       if (create != -1)
  117.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  118.       else
  119.     create = TRUE;
  120.       continue;
  121.     }
  122.  
  123.     if (op == sym_append) {
  124.       if (append != -1)
  125.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  126.       else
  127.     append = TRUE;
  128.       continue;
  129.     }
  130.  
  131.     if (op == sym_overwrite) {
  132.       if (append != -1)
  133.     CallError(stacktop,"open: exclusive options",ops,NONCONTINUABLE);
  134.       else
  135.     append = FALSE;
  136.       continue;
  137.     }
  138.  
  139.     if (op == sym_new_version) {
  140.       CallError(stacktop,"open: new-version unsupported",ops,NONCONTINUABLE);
  141.       continue;
  142.     }
  143.  
  144.     CallError(stacktop,"open: unrecognized option",op,NONCONTINUABLE);
  145.   }
  146.  
  147.   if (direction == NULL) direction = sym_input;
  148.   if (mode == NULL) mode = sym_character;
  149.   if (create == -1) create = (direction == sym_io ? FALSE : TRUE);
  150.   if (append == -1) append = (direction == sym_io ? TRUE : FALSE);
  151.  
  152.   if (direction == sym_input) {
  153.     way = "r";
  154.     fd = system_fopen(stringof(path),way);
  155.     if (fd == NULL)
  156.       CallError(stacktop,
  157.         "open: cannot open stream for reading",path,NONCONTINUABLE);
  158.     
  159.     str = (LispObject) allocate_stream(stacktop,fd,way[0]);  
  160.  
  161.     return(str);
  162.   }
  163.  
  164.   /* Potential output... */
  165.  
  166.   if (direction == sym_output) {
  167.     if (append)
  168.       way = "a";
  169.     else
  170.       way = "w";
  171.   }
  172.  
  173.   if (direction == sym_io) {
  174.     if (append) 
  175.       way = "r+";
  176.     else
  177.       way = "w+";
  178.   }
  179.   
  180.  retry:
  181.  
  182.   fd = system_fopen(stringof(path),way);
  183.   if (fd == NULL) {
  184.     if (create && retry_count < 1) {
  185.       if ((fd = system_fopen(stringof(path),"w")) != NULL) {
  186.     fclose(fd);
  187.     goto retry;
  188.       }
  189.     }
  190.     CallError(stacktop,"open: cannot open stream for writing/update",
  191.           path,NONCONTINUABLE);
  192.   }
  193.  
  194.   str = (LispObject) allocate_stream(stacktop,fd,way[0]);  
  195.  
  196.   return(str);
  197. }
  198. EUFUN_CLOSE
  199.  
  200. EUFUN_1( Fn_stream_position, str)
  201. {
  202.   int ans;
  203.  
  204.   if (!is_stream(str))
  205.     CallError(stacktop,"stream-position: not a stream",str,NONCONTINUABLE);
  206.  
  207.   if (str->STREAM.handle == NULL)
  208.     CallError(stacktop,"stream-position: null stream",str,NONCONTINUABLE);
  209.   ans = (int) ftell(str->STREAM.handle);
  210.   if (ans == -1)
  211.     CallError(stacktop,
  212.           "stream-position: invalid-stream-position",str,NONCONTINUABLE);
  213.   return(allocate_integer(stacktop,ans));
  214. }
  215. EUFUN_CLOSE
  216.  
  217. EUFUN_2( Fn_stream_position_setter, str, n)
  218. {
  219.   int end,pos;
  220.  
  221.   if (!is_stream(str))
  222.     CallError(stacktop,
  223.           "(setter stream-position): not a stream",str,NONCONTINUABLE);
  224.  
  225.   if (str->STREAM.handle == NULL)
  226.     CallError(stacktop,
  227.           "(setter stream-position): null stream",str,NONCONTINUABLE);
  228.  
  229.   if (n == sym_start) {
  230.     end = 0; pos = 0;
  231.   }
  232.   else if (n == sym_end) {
  233.     end = 2; pos = 0;
  234.   }
  235.   else if (!is_fixnum(n))
  236.     signal_message(stacktop,INVALID_STREAM_POSITION,
  237.            "(setter stream_position): bad position",n);
  238.   else {
  239.     end = 0; pos = intval(n);
  240.   }
  241.  
  242. #ifdef WITH_FUDGE
  243.   {
  244.     extern void yy_reset_stream(FILE *);
  245.     yy_reset_stream(str->STREAM.handle);
  246.   }
  247. #endif
  248.  
  249.   if (fseek(str->STREAM.handle,pos,end) != 0L)
  250.     signal_message(stacktop,INVALID_STREAM_POSITION,
  251.            "(setter stream-position): seek failed",n);
  252.   return(n);
  253. }
  254. EUFUN_CLOSE
  255.  
  256. EUFUN_1( Fn_end_of_stream_p, obj)
  257. {
  258.   return((obj == q_eof ? lisptrue : nil));
  259. }
  260. EUFUN_CLOSE
  261.  
  262. EUFUN_0( Fn_StdIn)
  263. {
  264.   return StdIn;
  265. }
  266. EUFUN_CLOSE
  267.  
  268. EUFUN_1( Fn_SetStdIn, new)
  269. {
  270.   while (!is_stream(new) || (new->STREAM).mode != 'r')
  271.     new = CallError(stacktop,"Not a stream in (set standard-input-stream)",
  272.             new,CONTINUABLE);
  273.   StdIn = new;
  274.   return nil;
  275. }
  276. EUFUN_CLOSE
  277.  
  278. EUFUN_0( Fn_StdOut)
  279. {
  280.   return StdOut;
  281. }
  282. EUFUN_CLOSE
  283.  
  284. EUFUN_1( Fn_SetStdOut, new)
  285. {
  286.   while (!is_stream(new) || (new->STREAM).mode == 'r')
  287.     new = CallError(stacktop,"Not a stream in (set standard-output-stream)",
  288.             new,CONTINUABLE);
  289.   StdOut = new;
  290.   return nil;
  291. }
  292. EUFUN_CLOSE
  293.  
  294. EUFUN_0( Fn_StdErr)
  295. {
  296.   return StdErr;
  297. }
  298. EUFUN_CLOSE
  299.  
  300. EUFUN_1( Fn_SetStdErr, new)
  301. {
  302.   while (!is_stream(new) || (new->STREAM).mode == 'r')
  303.     new = CallError(stacktop,"Not a stream in (set standard-error-stream)",
  304.             new,CONTINUABLE);
  305.   StdErr = new;
  306.   return nil;
  307. }
  308. EUFUN_CLOSE
  309.  
  310. EUFUN_0( Fn_TraceOut)
  311. {
  312.   return TraceOut;
  313. }
  314. EUFUN_CLOSE
  315.  
  316. EUFUN_1( Fn_SetTraceOut, new)
  317. {
  318.   while (!is_stream(new) || (new->STREAM).mode != 'r')
  319.     new = CallError(stacktop,"Not a stream in (set trace-output-stream)",
  320.             new,CONTINUABLE);
  321.   TraceOut = new;
  322.   return nil;
  323. }
  324. EUFUN_CLOSE
  325.  
  326. EUFUN_0( Fn_DebugIO)
  327. {
  328.   return DebugIO;
  329. }
  330. EUFUN_CLOSE
  331.  
  332. EUFUN_1( Fn_SetDebugIO, new)
  333. {
  334.   while (!is_stream(new) || (new->STREAM).mode != 'r')
  335.     new = CallError(stacktop,"Not a stream in (set debug-io-stream)",
  336.             new,CONTINUABLE);
  337.   DebugIO = new;
  338.   return nil;
  339. }
  340. EUFUN_CLOSE
  341.  
  342. EUFUN_1( Fn_close, stream)
  343. {
  344.   while (!is_stream(stream))
  345.     stream = CallError(stacktop,"Not a Stream",stream,CONTINUABLE);
  346.  
  347.   if (stream->STREAM.handle == NULL)
  348.     CallError(stacktop,"close: null stream",stream,NONCONTINUABLE);
  349.  
  350. #ifdef WITH_FUDGE
  351.   {
  352.     extern int yy_close_stream(FILE *);
  353.  
  354.     (void) yy_close_stream(stream->STREAM.handle);
  355.   }
  356. #else
  357.   system_fclose((stream->STREAM).handle);
  358. #endif
  359.  
  360.   (stream->STREAM).handle = NULL;
  361.   return nil;
  362. }
  363. EUFUN_CLOSE
  364.  
  365. EUFUN_1( Fn_flush, str)
  366. {
  367.   if (!is_stream(str))
  368.     CallError(stacktop,"flush: not a stream",str,NONCONTINUABLE);
  369.  
  370.   if (str->STREAM.handle == NULL)
  371.     CallError(stacktop,"flush: null stream",str,NONCONTINUABLE);
  372.  
  373.   /*
  374.   if (str->STREAM.mode != (int) 'w' && str->STREAM.mode != (int) 'a')
  375.   CallError(stacktop,"flush: not an output stream",str,NONCONTINUABLE);
  376.   */
  377.  
  378.   fflush(str->STREAM.handle);
  379.  
  380.   return(nil);
  381. }
  382. EUFUN_CLOSE
  383.  
  384. EUFUN_1( Fn_inputp, stream)
  385. {
  386.   if (is_stream(stream) && (stream->STREAM).mode=='r') return lisptrue;
  387.   return nil;
  388. }
  389. EUFUN_CLOSE
  390.  
  391. EUFUN_1( Fn_outputp, stream)
  392. {
  393.   if (is_stream(stream) && (stream->STREAM).mode!='r') return lisptrue;
  394.   return nil;
  395. }
  396. EUFUN_CLOSE
  397.  
  398. EUFUN_1( Fn_openp, stream)
  399. {
  400.   if (is_stream(stream) && (stream->STREAM).handle!=NULL) return lisptrue;
  401.   return nil;
  402. }
  403. EUFUN_CLOSE
  404.  
  405. EUFUN_1( Fn_emptyp, stream)
  406. {
  407.   if (is_stream(stream) && feof((stream->STREAM).handle)) return lisptrue;
  408.   return nil;
  409. }
  410. EUFUN_CLOSE
  411.  
  412. /* ******************************************************************** */
  413. /*                          Generic Writing                             */
  414. /* ******************************************************************** */
  415.  
  416. extern LispObject Fn_write(LispObject*);
  417.  
  418. LispObject generic_generic_write;
  419.  
  420. EUFUN_2( Gf_generic_write, obj, str)
  421. {
  422.   return(generic_apply_2(stacktop,generic_generic_write,obj,str));
  423. }
  424. EUFUN_CLOSE
  425.  
  426. EUFUN_2( Md_generic_write_Object, obj, str)
  427. {
  428.   if (!is_stream(str))
  429.     CallError(stacktop,"generic-write: invalid stream",str,NONCONTINUABLE);
  430.  
  431.   return(EUCALL_2(Fn_write,obj,str));
  432. }
  433. EUFUN_CLOSE
  434.  
  435. /* ******************************************************************** */
  436. /*                          Generic Printing                            */
  437. /* ******************************************************************** */
  438.  
  439. LispObject generic_generic_prin;
  440.  
  441. EUFUN_2( Gf_generic_prin, obj, str)
  442. {
  443.   return(generic_apply_2(stacktop,generic_generic_prin,obj,str));
  444. }
  445. EUFUN_CLOSE
  446.  
  447. EUFUN_2( Md_generic_prin_Object, obj, str)
  448. {
  449.   if (!is_stream(str))
  450.     CallError(stacktop,"generic-prin: invalid stream",str,NONCONTINUABLE);
  451.  
  452.   return(EUCALL_2(Fn_prin,obj,str));
  453. }
  454. EUFUN_CLOSE
  455.  
  456. EUFUN_2( Md_generic_prin_Pair, obj, str)
  457. {
  458.   FILE *handle;
  459.   LispObject walker;
  460.  
  461.   if (!is_stream(str))
  462.     CallError(stacktop,"generic-prin: invalid stream",str,NONCONTINUABLE);
  463.  
  464.   handle = (FILE *) (str->STREAM.handle);
  465.  
  466.   fprintf(handle,"(");
  467.   STACK(obj); STACK(str);
  468.   walker = obj;
  469.  
  470.   while (is_cons(walker)) {
  471.     STACK_TMP(CDR(walker));
  472.     EUCALL_2(Gf_generic_prin,CAR(walker),ARG_1(stackbase));
  473.     UNSTACK_TMP(walker);
  474.     if (is_cons(walker)) fprintf(handle," ");
  475.   }
  476.  
  477.   if (walker == nil) 
  478.     fprintf(handle,")");
  479.   else {
  480.     fprintf(handle," . ");
  481.     EUCALL_2(Gf_generic_prin,walker,ARG_1(stackbase));
  482.     fprintf(handle,")");
  483.   }
  484.  
  485.   UNSTACK(2);
  486.  
  487.   return(ARG_0(stackbase));
  488. }
  489. EUFUN_CLOSE
  490.  
  491. EUFUN_2( FN_prin, obj, args)
  492. {
  493.   EUCALL_2(Gf_generic_prin,obj,(is_cons(args) ? CAR(args) : StdOut));
  494.   return(ARG_0(stackbase));
  495. }
  496. EUFUN_CLOSE
  497.  
  498. EUFUN_1( FN_newline, str)
  499. {
  500.   LispObject s;
  501.  
  502.   if (str == nil)
  503.     s = StdOut;
  504.   else {
  505.     if (!is_cons(str))
  506.       CallError(stacktop,"newline: invalid stream",str,NONCONTINUABLE);
  507.  
  508.     str = CAR(str);
  509.  
  510.     if (!is_stream(str))
  511.       CallError(stacktop,"newline: invalid stream",str,NONCONTINUABLE);
  512.  
  513.     s = str;
  514.   }
  515.  
  516.   fprintf(s->STREAM.handle,"\n");
  517.  
  518.   return(nil);
  519. }
  520. EUFUN_CLOSE
  521.  
  522. EUFUN_2( FN_print, obj, args)
  523. {
  524.   LispObject str = (is_cons(args) ? CAR(args) : StdOut);
  525.  
  526.   EUCALL_2(Gf_generic_prin,obj,str);
  527.   EUCALL_1(FN_newline,ARG_1(stackbase)/*args*/);
  528.  
  529.   return(ARG_0(stackbase));
  530. }
  531. EUFUN_CLOSE
  532.  
  533. EUFUN_2( FN_write, obj, args)
  534. {
  535.   EUCALL_2(Gf_generic_write,obj,(is_cons(args) ? CAR(args) : StdOut));
  536.   return(ARG_0(stackbase));
  537. }
  538. EUFUN_CLOSE
  539.  
  540. /*
  541.  * Hack at "popen"...
  542.  */
  543.  
  544. EUFUN_2( Fn_popen, path, mode)
  545. {
  546. #ifdef HAS_POPEN
  547.   extern FILE *popen(char *,char *);
  548.  
  549.   LispObject retval;
  550.   char *cmode;
  551.   FILE *cstream;
  552.  
  553.   if (!is_string(path))
  554.     CallError(stacktop,"popen: non string path",path,NONCONTINUABLE);
  555.  
  556.   if (mode == sym_input) {
  557.     cmode = "r";
  558.   }
  559.   else if (mode == sym_output) {
  560.     cmode = "w";
  561.   }
  562.   else 
  563.     CallError(stacktop,"popen: unknown mode",mode,NONCONTINUABLE);
  564.  
  565.   /* Open it up... */
  566.  
  567.   cstream = popen(stringof(path),cmode);
  568.  
  569.   if (cstream == NULL)
  570.     CallError(stacktop,"popen: can't execute command",path,NONCONTINUABLE);
  571.  
  572.   /* Grab a stream... */
  573.  
  574.   retval = allocate_stream(stacktop,cstream,cmode[0]);
  575.  
  576.   return(retval);
  577. #else
  578.   CallError(stacktop,"popen called",nil,NONCONTINUABLE);
  579.   return (nil);
  580. #endif
  581. }
  582. EUFUN_CLOSE
  583.  
  584. LispObject X_Server_Handle;
  585.  
  586. /* *************************************************************** */
  587. /* Initialisation of this section                                  */
  588. /* *************************************************************** */
  589.  
  590. #define STREAMS_ENTRIES 43
  591. MODULE Module_streams;
  592. LispObject Module_streams_values[STREAMS_ENTRIES];
  593.  
  594. void initialise_streams(LispObject *stacktop)
  595. {
  596.   LispObject fun,upd;
  597.  
  598.   open_module(stacktop,
  599.           &Module_streams,
  600.           Module_streams_values,
  601.           "streams",
  602.           STREAMS_ENTRIES);
  603.  
  604.   sym_input = (LispObject) get_symbol(stacktop,"input");
  605.   sym_output = (LispObject) get_symbol(stacktop,"output");
  606.   sym_io = (LispObject) get_symbol(stacktop,"io");
  607.  
  608.   sym_character = (LispObject) get_symbol(stacktop,"character");
  609.   sym_binary = get_symbol(stacktop,"binary");
  610.  
  611.   sym_append = (LispObject) get_symbol(stacktop,"append");
  612.   sym_create = get_symbol(stacktop,"create");
  613.   sym_overwrite = get_symbol(stacktop,"overwrite");
  614.   sym_new_version = get_symbol(stacktop,"new-version");
  615.  
  616.   sym_start = get_symbol(stacktop,"start");
  617.   sym_end = get_symbol(stacktop,"end");
  618.   
  619.   add_root(&sym_input);
  620.   add_root(&  sym_output);
  621.   add_root(&  sym_io);
  622.  
  623.   add_root(&  sym_character);
  624.   add_root(&  sym_binary);
  625.  
  626.   add_root(&  sym_append);
  627.   add_root(&  sym_create);
  628.   add_root(&  sym_overwrite);
  629.   add_root(&  sym_new_version);
  630.  
  631.   add_root(&  sym_start);
  632.   add_root(&  sym_end);
  633.   
  634.   initialise_input(stacktop);
  635.   initialise_output(stacktop);
  636.  
  637.   (void) make_module_entry(stacktop,"*eos*",q_eof);
  638.   (void) make_module_function(stacktop,"streamp",Fn_streamp,1);
  639.   (void) make_module_function(stacktop,"open",Fn_open,-2);
  640.  
  641.   fun = make_module_function(stacktop,"stream-position",Fn_stream_position,1);
  642.   STACK_TMP(fun);
  643.   upd = make_unexported_module_function(stacktop,"stream_position_setter",
  644.                     Fn_stream_position_setter,2);
  645.   UNSTACK_TMP(fun);
  646.   set_anon_associate(stacktop,fun,upd);
  647.  
  648.   (void) make_module_function(stacktop,"end-of-stream-p",Fn_end_of_stream_p,1);
  649.  
  650.   fun = make_module_function(stacktop,"standard-input-stream",Fn_StdIn,0);
  651.   STACK_TMP(fun);
  652.   upd = make_module_function(stacktop,"standard-input-stream-updator", Fn_SetStdIn,1);
  653.   UNSTACK_TMP(fun);
  654.   set_anon_associate(stacktop,fun,upd);
  655.   fun =  make_module_function(stacktop,"standard-output-stream",Fn_StdOut,0);
  656.   STACK_TMP(fun);
  657.   upd =  make_module_function(stacktop,"standard-output-stream-updator",Fn_SetStdOut,1);
  658.   UNSTACK_TMP(fun);
  659.   set_anon_associate(stacktop,fun,upd);
  660.   fun = make_module_function(stacktop,"standard-error-stream",Fn_StdErr,0);
  661.   STACK_TMP(fun);
  662.   upd = make_module_function(stacktop,"standard-error-stream-updator",Fn_SetStdErr,1);
  663.   UNSTACK_TMP(fun);
  664.   set_anon_associate(stacktop,fun,upd);
  665.   fun = make_module_function(stacktop,"trace-output-stream",Fn_TraceOut,0);
  666.   STACK_TMP(fun);
  667.   upd = make_module_function(stacktop,"trace-output-stream-updator",Fn_SetTraceOut,1);
  668.   UNSTACK_TMP(fun);
  669.   set_anon_associate(stacktop,fun,upd);
  670.   fun = make_module_function(stacktop,"debug-io-stream",Fn_DebugIO,0);
  671.   STACK_TMP(fun);
  672.   upd = make_module_function(stacktop,"debug-io-stream-updator",Fn_SetDebugIO,1);
  673.   UNSTACK_TMP(fun);
  674.   set_anon_associate(stacktop,fun,upd);
  675.   StdIn = (LispObject) allocate_stream(stacktop,stdin,'r');
  676.   add_root(&StdIn);
  677.   StdOut = (LispObject) allocate_stream(stacktop,stdout,'a');
  678.   add_root(&StdOut);
  679.   StdErr = (LispObject) allocate_stream(stacktop,stderr,'a');
  680.   add_root(&StdErr);
  681.   TraceOut = StdErr;
  682.   add_root(&TraceOut);
  683.   DebugIO = StdErr;
  684.   add_root(&DebugIO);
  685.   (void) make_module_function(stacktop,"close",Fn_close,1);
  686.   (void) make_module_function(stacktop,"flush",Fn_flush,1);
  687.   (void) make_module_function(stacktop,"input-stream-p",Fn_inputp,1);
  688.   (void) make_module_function(stacktop,"output-stream-p",Fn_outputp,1);
  689.   (void) make_module_function(stacktop,"open-stream-p",Fn_openp,1);
  690.   (void) make_module_function(stacktop,"empty-stream-p",Fn_emptyp,1);
  691.  
  692.   generic_generic_write 
  693.     = make_wrapped_module_generic(stacktop,"generic-write",2,Gf_generic_write);
  694.   add_root(&generic_generic_write); 
  695.   (void) make_module_function(stacktop,"generic_generic_write,Object",
  696.                   Md_generic_write_Object,2);
  697.  
  698.   generic_generic_prin 
  699.     = make_wrapped_module_generic(stacktop,"generic-prin",2,Gf_generic_prin);
  700.   add_root(&generic_generic_prin);
  701.   (void) make_module_function(stacktop,"generic_generic_prin,Object",
  702.                   Md_generic_prin_Object,2);
  703.   (void) make_module_function(stacktop,"generic_generic_prin,Cons",
  704.                   Md_generic_prin_Pair,2);
  705.  
  706.   (void) make_module_function(stacktop,"prin",FN_prin,-2);
  707.   (void) make_module_function(stacktop,"write",FN_write,-2);
  708.   (void) make_module_function(stacktop,"newline",FN_newline,-1);
  709.   (void) make_module_function(stacktop,"print",FN_print,-2);
  710.  
  711.   (void) make_module_function(stacktop,"popen",Fn_popen,2);
  712.  
  713.   {
  714.     extern int command_line_window_flag;
  715.     FILE *handle;
  716. #ifdef HAS_POPEN
  717.     FILE *popen(char *,char *);
  718.  
  719.     if (command_line_window_flag) {
  720.  
  721.       handle = popen("xserver -rv 500 500","w");
  722.       fprintf(handle,"7 210 10 EuLisp FEEL\n"); fflush(handle);
  723.       X_Server_Handle = (LispObject) allocate_stream(stacktop,handle,'w');
  724.     }
  725.     else
  726.       X_Server_Handle = StdOut;
  727. #else
  728.     X_Server_Handle = StdOut;
  729. #endif
  730.     add_root(&X_Server_Handle);
  731.  
  732.     make_module_entry(stacktop,"X-stream",X_Server_Handle);
  733.   }
  734.  
  735.   close_module();
  736. }
  737.